{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Colours;

interface

uses Classes, UIObjects, Graphics, Colour, XMLHelper;

const
  DEFAULT_BLACK_COLOUR = '0xff000000';
  DEFAULT_COLOUR_DESC = 'System defined default colour';
  DEFAULT_WHITE_NAME = 'white';
  DEFAULT_WHITE_COLOUR = '0xffffffff';

{$IFDEF DESIGNER}
  MODIFY_CAPTION = 'Edit Colour';

  // Property categories and hints for designer
  CAT_COLOUR = 'Colour';
  HINT_RGB = 'defines red green and blue colour values';
  HINT_ALPHA = 'defines the alpha (transparency) value for the colour ranging' +
               ' from 0 (transparent) to 255 (opaque)';
{$ENDIF}

type
  TAHMColourString = type String;

  TAHMColour = class(TAHMUIObject)
  private
    FColour: TAHMCanvasColour;
    FDefinition: String;
  protected
    function GetRGBString: TAHMColourString;
    procedure SetRGBString(Value: TAHMColourString);
    function GetAlpha: Integer;
    procedure SetAlpha(Alpha: Integer);
    function GetColourDef: String;
    procedure SetColourDef(const Definition: String);
    procedure ClearProperties; override;
  public
    constructor Create(const Name: String); override;
    destructor Destroy; override;
    property Colour: TAHMCanvasColour read FColour;
    property ColourDef: String read GetColourDef write SetColourDef;
    function RenderPreview: Boolean; override;
    function ModifyActions: Integer; override;
    function Modify(Action: Integer): Boolean; override;
    function ModifyCaption(Action: Integer): String; override;
    procedure Assign(Source: TPersistent); override;
    procedure SaveAsXML(Lines: TStrings); override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
    procedure BuildProperties(Properties: TAHMUIPropertyList); override;
  published
    property ColourRGB: TAHMColourString read GetRGBString write SetRGBString;
    property ColourAlpha: Integer read GetAlpha write SetAlpha;
  end;

  TAHMColourList = class(TAHMUIObjectList)
  private
  protected
  public
    constructor Create; override;
    function AddColour(const InheritFrom, NewName: String): TAHMColour; overload;
    function GetColour(const Name: String): TAHMColour;
    function RequiresSaving: Boolean; override;
    procedure PopulateDefaultObjects; override;
  end;


implementation

uses SysUtils, Dialogs, ApplicationManager, Screen, TagNames, XMLTags, AHMTypes;

{$IFDEF DESIGNER}
var
  GlobalCustomColours: TStringList;
{$ENDIF}

constructor TAHMColourList.Create;
var
  oColour: TAHMColour;
begin
  inherited Create;

  XMLTagName := TAG_COLOURS;
  ChildClass := TAHMColour;
  FSpaceElements := False;

  // Add default colour object
  oColour := TAHMColour(Inherit('', DEFAULT_OBJECT_NAME));
  oColour.Description := DEFAULT_COLOUR_DESC;
  oColour.ColourDef := DEFAULT_BLACK_COLOUR;
end;

function TAHMColourList.RequiresSaving: Boolean;
begin
  // Don't need to save our default colour object
  Result := (Count > 1);
end;

function TAHMColourList.AddColour(const InheritFrom, NewName: String): TAHMColour;
begin
  Result := TAHMColour(Inherit(InheritFrom, NewName));
end;

function TAHMColourList.GetColour(const Name: String): TAHMColour;
begin
  // Get requested colour - if not found then return default colour instead
  Result := TAHMColour(GetObject(Name));
  if Result = nil then
    Result := TAHMColour(GetObject(DEFAULT_OBJECT_NAME));
end;

procedure TAHMColourList.PopulateDefaultObjects;
begin
  with DefaultObject as TAHMColour do
    ColourDef := 'ffffffff';
end;

//----------------------------------------------------------------------------//

constructor TAHMColour.Create(const Name: String);
begin
  inherited Create(Name);

  XMLTagName := TAG_COLOUR;
  ObjectType := otColours;
  ImageIndex := Ord(otColours);

  FColour := TAHMCanvasColour.Create;
  ClearProperties;
end;

destructor TAHMColour.Destroy;
begin
  FColour.Free;

  inherited Destroy;
end;

function TAHMColour.GetRGBString: TAHMColourString;
begin
  with FColour do
    Result := UpperCase(IntToHex(Pixel[ctRed], 2) + IntToHex(Pixel[ctGreen], 2) + IntToHex(Pixel[ctBlue], 2));
end;

procedure TAHMColour.SetRGBString(Value: TAHMColourString);
var
  Alpha: Byte;
begin
  // Preserve current alpha value whilst changing
  Alpha := FColour.InternalAlpha;
  SetColourDef(Value);
  FColour.InternalAlpha := Alpha;
  ApplicationManagerInstance.UIManager.InvalidateUIObject(Self);
end;

function TAHMColour.GetColourDef: String;
begin
  Result := '0x' + UpperCase(IntToHex(FColour.Pixel[ctAlpha], 2)) + GetRGBString;
end;

procedure TAHMColour.SetColourDef(const Definition: String);
var
  sWork: String;
  Pixel: TColourPixel;
begin
  try
    // Colour should be specified using 0xaarrggbb format
    FDefinition := Definition;
    sWork := Definition;

    // Strip optional 0x prefix
    if (UpperCase(Copy(sWork, 1, 2)) = '0X') then
      sWork := Copy(sWork, 3, 8);

    // Get alpha value if present
    if (Length(sWork) > 6) then
    begin
      Pixel[ctAlpha] := StrToInt('$' + Copy(sWork, 1, 2));
      sWork := Copy(sWork, 3, 6);
    end
    else
      Pixel[ctAlpha] := $FF;

    // Delphi uses a dodgy BGR format, so switch things about
    Pixel[ctRed] := StrToInt('$' + Copy(sWork, 1, 2));
    Pixel[ctGreen] := StrToInt('$' + Copy(sWork, 3, 2));
    Pixel[ctBlue] := StrToInt('$' + Copy(sWork, 5, 2));
  except
    // If any exceptions raised default colour to solid grey instead
    Pixel[ctRed] := $80;
    Pixel[ctGreen] := $80;
    Pixel[ctBlue] := $80;
    Pixel[ctAlpha] := $FF;
  end;

  // Assign our colour definition to internal canvas colour object
  FColour.Pixel := Pixel;
end;

function TAHMColour.GetAlpha: Integer;
begin
  Result := FColour.InternalAlpha;
end;

procedure TAHMColour.SetAlpha(Alpha: Integer);
begin
  FColour.InternalAlpha := Alpha;
  ApplicationManagerInstance.UIManager.InvalidateUIObject(Self);
end;

procedure TAHMColour.ClearProperties;
begin
  inherited;

  // Clear custom colour properties
  SetColourDef(DEFAULT_WHITE_COLOUR);
end;

function TAHMColour.RenderPreview: Boolean;
begin
{$IFDEF DESIGNER}
  with ScreenInstance.Viewport do
  begin
    Canvas.DesignerBackground(ViewportRect);
    Canvas.BrushColour := FColour;
    Canvas.FillRect(ViewportRect, nil, nil, 1.0, 1.0);
  end;
{$ENDIF}
  Result := True;
end;

function TAHMColour.ModifyActions: Integer;
begin
  // Only supports colour editing action
  Result := 1;
end;

function TAHMColour.Modify(Action: Integer): Boolean;
begin
{$IFDEF DESIGNER}
  // Edit colour with dialog
  with TColorDialog.Create(nil) do
  try
    Color := RGBStringToColor(GetRGBString);
    Options := [cdFullOpen, cdSolidColor];
    CustomColors.Assign(GlobalCustomColours);
    Result := Execute;

    if Result then
    begin
      SetRGBString(ColorToRGBString(Color));
      GlobalCustomColours.Assign(CustomColors);
      DoModified;
      ApplicationManagerInstance.UIManager.InvalidateUIObject(Self);
    end;
  finally
    Free;
  end;
{$ELSE}
  Result := False;
{$ENDIF}
end;

function TAHMColour.ModifyCaption(Action: Integer): String;
begin
{$IFDEF DESIGNER}
  Result := MODIFY_CAPTION;
{$ELSE}
  Result := '';
{$ENDIF}
end;

procedure TAHMColour.Assign(Source: TPersistent);
begin
  inherited Assign(Source);

  with Source as TAHMColour do
    Self.ColourDef := ColourDef;
end;

procedure TAHMColour.SaveAsXML(Lines: TStrings);
var
  oAncs: TAHMColour;
begin
  // Don't save our dummy default colour
  if Name = DEFAULT_OBJECT_NAME then Exit;

  // Determine which ancestor to compare against - real or empty
  oAncs := TAHMColour(ObjectToCompare);

  // We need to explicitly save comments in overridden method
  SaveXMLComments(Lines);

  // Only populate attributes that differ from our ancestor
  if (ColourDef <> '') and (ColourDef <> oAncs.ColourDef) then
    Lines.Add(TABS[2] + TagBegin + LowerCase(ColourDef) + TagEnd)
  else
    Lines.Add(TABS[2] + TagBegin + TagEnd);
end;

procedure TAHMColour.ParseFromXML(XML: TAHMXMLHelper);
var
  sValue: String;
begin
  // Just parse colour value
  sValue := XML.GetValue;
  if sValue <> '' then ColourDef := sValue;
end;

procedure TAHMColour.BuildProperties(Properties: TAHMUIPropertyList);
begin
{$IFDEF DESIGNER}
  inherited;

  // Build custom colour properties
  Properties.Add('RGB', 'ColourRGB', CAT_COLOUR, HINT_RGB);
  Properties.Add('Alpha', 'ColourAlpha', CAT_COLOUR, HINT_ALPHA);
{$ENDIF}
end;

{$IFDEF DESIGNER}
initialization
  // Create our longterm property editor support objects
  GlobalCustomColours := TStringList.Create;

finalization
  // Free our longterm property editor support objects
  GlobalCustomColours.Free;
{$ENDIF}

end.
